home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tricks of the Mac Game Programming Gurus
/
TricksOfTheMacGameProgrammingGurus.iso
/
More Source
/
Pascal
/
Book Demos in Pascal
/
SpriteEngine
/
SpriteTools.p
< prev
Wrap
Text File
|
1995-04-04
|
11KB
|
388 lines
{ SpriteTools}
{ Routines to be called from the engine and from SpriteHandlers}
unit SpriteTools;
interface
uses
{$IFC UNDEFINED THINK_PASCAL}
Types, QuickDraw, Fonts, Events, Packages, Menus, Dialogs, Windows,{}
OSUtils, ToolUtils, OSEvents, Memory,
{$ENDC}
QDOffScreen, SpriteStructure;
{MyNewGWorld: Creates a GWorld}
{LoadFaceFromCicn: Loads a face}
{PlotFace: Draws a face}
{NewSprite: Creates a sprite}
{DisposeSprite: Disposes a sprite}
{KeepOnScreen: Performs border checks for a sprite}
{RectSeparate: Moves two sprites apart}
{ Delay constant}
const
kFrameTime = 1;
(* The window pointer *)
var
myWindow: WindowPtr;
(****************************************)
(* Global variables for sprite handling *)
(****************************************)
{ EntityType and SpriteRecord are defined in SpriteHandlers.h}
(* A global pointer is the root of the entity list *)
gSpriteList: SpritePtr;
(* GWorlds for the animation and background buffers *)
gOffScreen, gBackScreen: GrafPtr;
(*** End of sprite handling variables ***)
{ Routines in SpriteTools.c}
procedure MyNewGWorld (var offscreenGWorld: GrafPtr; var boundsRect: Rect);
function LoadFaceFromCicn (cicnId: Integer): GrafPtr;
procedure PlotFace (theCicn: GrafPtr; destPort: GrafPtr; where: Point);
(*Sprite list management*)
function NewSprite: SpritePtr;
procedure DisposeSprite (who: SpritePtr);
(*Sprite utilities*)
function KeepOnScreen (theSprite: SpritePtr): Boolean;
function KeepOnScreenFixed (theSprite: SpritePtr): Boolean;
function RectSeparate (theSprite: SpritePtr; anotherSprite: SpritePtr): Integer;
function Rand (range: Integer): Integer;
function RegionHit (theSprite: SpritePtr; anotherSprite: SpritePtr): Boolean;
procedure SplitVector (v: Point; d: Point; var p: Point; var n: Point);
implementation
procedure DoError;
begin
SysBeep(1);
ExitToShell;
end;
(*MyNewGWorld: Glue to NewGWorld*)
(*I declare offscreenGWorld as GrafPtr to save us a bunch of typecasts later (in CopyBits).*)
(*Most parameters to NewGWorld omitted - NewGWorld is smart enough to make the defaults useable.*)
procedure MyNewGWorld (var offscreenGWorld: GrafPtr; var boundsRect: Rect);
var
saveGD: GDHandle;
savePort: GWorldPtr;
begin
GetGWorld(savePort, saveGD);
if noErr <> NewGWorld(GWorldPtr(offscreenGWorld), 0, boundsRect, nil, nil, [pixelsLocked]) then
DoError;
(*We lock the offscreen pixmap so we can CopyBits and PlotCIcon to it.*)
if LockPixels(CGrafPtr(offscreenGWorld)^.portPixMap) then
;
(*Note: We should unlock it (UnlockPixels) when not animating, to avoid memory fragmentation,*)
(*but you can bother with that later if it's a problem.*)
SetGWorld(savePort, saveGD);
end; (*MyNewGWorld*)
function LoadFaceFromCicn (cicnId: Integer): GrafPtr;
var
offscreenGWorld: GrafPtr;
theCicn: CIconHandle;
saveGD: GDHandle;
savePort: GWorldPtr;
begin
GetGWorld(savePort, saveGD);
theCicn := GetCIcon(cicnId);
MyNewGWorld(offscreenGWorld, theCicn^^.iconMask.bounds);
if offscreenGWorld <> nil then
begin
SetGWorld(GWorldPtr(offscreenGWorld), nil);
PlotCIcon(theCicn^^.iconMask.bounds, theCicn);
(*I use the clipRgn for storing the mask region. This may seem dangerous,}
{but when we aren't drawing in the GWorld anyway, it won't matter.*)
if offscreenGWorld = nil then
offscreenGWorld^.clipRgn := NewRgn;
if (noErr <> BitMapToRegion(offscreenGWorld^.clipRgn, theCicn^^.iconMask)) then(**)
offscreenGWorld^.clipRgn := nil;(*or DisposeRgn?*)
DisposeCIcon(theCicn);
end;
SetGWorld(savePort, saveGD);
LoadFaceFromCicn := offscreenGWorld;
end; (*LoadFaceFromCicn*)
var
gTmpRgn: RgnHandle;
procedure PlotFace (theCicn: GrafPtr; destPort: GrafPtr; where: Point);
var
saveGD: GDHandle;
savePort: GWorldPtr;
bounds: Rect;
saveForeColor, saveBackColor: RGBColor;
begin
GetGWorld(savePort, saveGD);
bounds := theCicn^.portRect;
OffsetRect(bounds, where.h - bounds.left, where.v - bounds.top);
if gTmpRgn = nil then
gTmpRgn := NewRgn; (*For top speed, we make this global, and create it only once!*)
CopyRgn(theCicn^.clipRgn, gTmpRgn);
OffsetRgn(gTmpRgn, where.h, where.v);
SetPort(destPort); (*I assume that the device is correctly set.*)
GetForeColor(saveForeColor);
GetBackColor(saveBackColor);
ForeColor(blackColor);
BackColor(whiteColor);
CopyBits(theCicn^.portBits, destPort^.portBits, theCicn^.portRect, bounds, srcCopy, gTmpRgn);
RGBForeColor(saveForeColor);
RGBBackColor(saveBackColor);
SetGWorld(savePort, saveGD);
end; (*PlotFace*)
(*************************************)
(* Routines for sprite list handling *)
(*************************************)
(* NewSprite allocates space for a new entity and puts it in the entity list *)
function NewSprite: SpritePtr;
var
who: SpritePtr;
begin
who := SpritePtr(NewPtr(sizeof(SpriteRecord)));
if who = nil then
begin
NewSprite := nil;
exit(NewSprite);
end;
if gSpriteList <> nil then
begin
gSpriteList^.prev := who;
end;
who^.next := gSpriteList;
who^.prev := nil;
gSpriteList := who;
NewSprite := who;
end; (*NewSprite*)
(* DisposeSprite removes an entity from the list and disposes it. *)
procedure DisposeSprite (who: SpritePtr);
begin
if who = nil then
exit(DisposeSprite);
if (who^.next <> nil) then
who^.next^.prev := who^.prev;
if (who^.prev <> nil) then
who^.prev^.next := who^.next;
if (who = gSpriteList) then
gSpriteList := who^.next;
DisposePtr(Ptr(who));
end; (*DisposeSprite*)
(*** End of sprite handling routines ***)
(* KeepOnScreen makes border checks to keep the sprite within the window.}
{on a border hit, the speed is negated in order to make the sprite bounce.}
{KeepOnScreen returns true if a border was hit. *)
function KeepOnScreen (theSprite: SpritePtr): Boolean;
var
returnValue: Boolean;
begin
returnValue := false;
if theSprite^.position.h < 0 then
begin
theSprite^.position.h := 0;
theSprite^.speed.h := abs(theSprite^.speed.h);
returnValue := true;
end;
if theSprite^.position.v < 0 then
begin
theSprite^.position.v := 0;
theSprite^.speed.v := abs(theSprite^.speed.v);
returnValue := true;
end;
if theSprite^.position.h > gOffScreen^.portRect.right - theSprite^.face^.portRect.right then
begin
theSprite^.position.h := gOffScreen^.portRect.right - theSprite^.face^.portRect.right;
theSprite^.speed.h := -abs(theSprite^.speed.h);
returnValue := true;
end;
if theSprite^.position.v > gOffScreen^.portRect.bottom - theSprite^.face^.portRect.bottom then
begin
theSprite^.position.v := gOffScreen^.portRect.bottom - theSprite^.face^.portRect.bottom;
theSprite^.speed.v := -abs(theSprite^.speed.v);
returnValue := true;
end;
KeepOnScreen := returnValue;
end; (*KeepOnScreen*)
{$ifc _hasfixedpoint}
(*Same as above, but also modifies the fixedPointPosition field*)
function KeepOnScreenFixed (theSprite: SpritePtr): Boolean;
var
returnValue: Boolean;
begin
returnValue := false;
if theSprite^.fixedPointPosition.h < 0 then
begin
theSprite^.position.h := 0;
theSprite^.fixedPointPosition.h := 0;
theSprite^.speed.h := abs(theSprite^.speed.h);
returnValue := true;
end;
if (theSprite^.fixedPointPosition.v < 0) then
begin
theSprite^.position.v := 0;
theSprite^.fixedPointPosition.v := 0;
theSprite^.speed.v := abs(theSprite^.speed.v);
returnValue := true;
end;
if (theSprite^.position.h > gOffScreen^.portRect.right - theSprite^.face^.portRect.right) then
begin
theSprite^.position.h := gOffScreen^.portRect.right - theSprite^.face^.portRect.right;
theSprite^.fixedPointPosition.h := BSL(theSprite^.position.h, 4);
theSprite^.speed.h := -abs(theSprite^.speed.h);
returnValue := true;
end;
if (theSprite^.position.v > gOffScreen^.portRect.bottom - theSprite^.face^.portRect.bottom) then
begin
theSprite^.position.v := gOffScreen^.portRect.bottom - theSprite^.face^.portRect.bottom;
theSprite^.fixedPointPosition.v := BSL(theSprite^.position.v, 4);
theSprite^.speed.v := -abs(theSprite^.speed.v);
returnValue := true;
end;
KeepOnScreenFixed := returnValue
end; (*KeepOnScreenFixed*)
{$endc}
(* Moves two sprites apart, to separate them with respect to their bounding boxes. *)
function RectSeparate (theSprite: SpritePtr; anotherSprite: SpritePtr): Integer;
var
distance: array[0..3] of Integer;
shortest, shortestDistance, i: Integer;
bounds1, bounds2: Rect;
begin
bounds1 := theSprite^.face^.portRect;
OffsetRect(bounds1, theSprite^.position.h, theSprite^.position.v);
bounds2 := anotherSprite^.face^.portRect;
OffsetRect(bounds2, anotherSprite^.position.h, anotherSprite^.position.v);
(*Calculate the distance to separate the sprites in every direction*)
distance[0] := bounds2.top - bounds1.bottom; {up}
distance[1] := bounds2.bottom - bounds1.top; {down}
distance[2] := bounds2.right - bounds1.left; {right}
distance[3] := bounds2.left - bounds1.right; {left}
(*Find the shortest distance*)
shortest := 0;
shortestDistance := abs(distance[0]);
for i := 1 to 3 do
if abs(distance[i]) < shortestDistance then
begin
shortest := i;
shortestDistance := abs(distance[i]);
end;
(*Move the sprite in the appropriate direction*)
case shortest of
0, 1:
theSprite^.position.v := theSprite^.position.v + distance[shortest];
2, 3:
theSprite^.position.h := theSprite^.position.h + distance[shortest];
end; {case}
RectSeparate := shortest;
end; (*RectSeparate*)
(* Random number from 0 to range-1 *)
function Rand (range: Integer): Integer;
var
roll: Integer;
begin
roll := Random;
Rand := abs(roll) mod range;
end; (*Rand*)
(* Collision test using regions! *)
function RegionHit (theSprite: SpritePtr; anotherSprite: SpritePtr): Boolean;
var
faceRegion1, faceRegion2: RgnHandle;
result: Boolean;
begin
faceRegion1 := NewRgn;
faceRegion2 := NewRgn;
CopyRgn(theSprite^.face^.clipRgn, faceRegion1);
OffsetRgn(faceRegion1, theSprite^.position.h, theSprite^.position.v);
CopyRgn(anotherSprite^.face^.clipRgn, faceRegion2);
OffsetRgn(faceRegion2, anotherSprite^.position.h, anotherSprite^.position.v);
SectRgn(faceRegion1, faceRegion2, faceRegion1);
result := not EmptyRgn(faceRegion1);
DisposeRgn(faceRegion1);
DisposeRgn(faceRegion2);
RegionHit := result;
end; (*RegionHit*)
(* Split a vector v into a component p parallel to another vector d,}
{and a compionent n that is perpendicular to d. Useful for realistic}
{collision handling! *)
procedure SplitVector (v: Point; d: Point; var p: Point; var n: Point);
var
length2, dotProduct: LongInt;
begin
length2 := d.h * d.h + d.v * d.v; (*Squared length of "d"*)
dotProduct := v.h * d.h + v.v * d.v; (*Scalar product*)
p.h := d.h * dotProduct div length2;
p.v := d.v * dotProduct div length2;
n.h := v.h - p.h;
n.v := v.v - p.v;
end; (* SplitVector *)
end.